home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / stab.c < prev    next >
Text File  |  1993-10-23  |  24KB  |  1,063 lines
  1. /* $RCSfile: stab.c,v $$Revision: 4.0.1.5 $$Date: 1993/02/05 19:42:47 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the Perl Artistic License,
  6.  *    as specified in the README file.
  7.  *
  8.  * $Log:    stab.c,v $
  9.  * Revision 4.0.1.5  1993/02/05  19:42:47  lwall
  10.  * patch36: length returned wrong value on certain semi-magical variables
  11.  *
  12.  * Revision 4.0.1.4  92/06/08  15:32:19  lwall
  13.  * patch20: fixed confusion between a *var's real name and its effective name
  14.  * patch20: the debugger now warns you on lines that can't set a breakpoint
  15.  * patch20: the debugger made perl forget the last pattern used by //
  16.  * patch20: paragraph mode now skips extra newlines automatically
  17.  * patch20: ($<,$>) = ... didn't work on some architectures
  18.  * 
  19.  * Revision 4.0.1.3  91/11/05  18:35:33  lwall
  20.  * patch11: length($x) was sometimes wrong for numeric $x
  21.  * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
  22.  * patch11: *foo = undef coredumped
  23.  * patch11: solitary subroutine references no longer trigger typo warnings
  24.  * patch11: local(*FILEHANDLE) had a memory leak
  25.  * 
  26.  * Revision 4.0.1.2  91/06/07  11:55:53  lwall
  27.  * patch4: new copyright notice
  28.  * patch4: added $^P variable to control calling of perldb routines
  29.  * patch4: added $^F variable to specify maximum system fd, default 2
  30.  * patch4: $` was busted inside s///
  31.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  32.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  33.  * patch4: $^D |= 1024 now does syntax tree dump at run-time
  34.  * 
  35.  * Revision 4.0.1.1  91/04/12  09:10:24  lwall
  36.  * patch1: Configure now differentiates getgroups() type from getgid() type
  37.  * patch1: you may now use "die" and "caller" in a signal handler
  38.  * 
  39.  * Revision 4.0  91/03/20  01:39:41  lwall
  40.  * 4.0 baseline.
  41.  * 
  42.  */
  43.  
  44. #include "EXTERN.h"
  45. #include "perl.h"
  46.  
  47. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  48. #include <signal.h>
  49. #endif
  50.  
  51. static char *sig_name[] = {
  52.     SIG_NAME,0
  53. };
  54.  
  55. #ifdef VOIDSIG
  56. #define handlertype void
  57. #else
  58. #define handlertype int
  59. #endif
  60.  
  61. static handlertype sighandler();
  62.  
  63. static int origalen = 0;
  64.  
  65. STR *
  66. stab_str(str)
  67. STR *str;
  68. {
  69.     STAB *stab = str->str_u.str_stab;
  70.     register int paren;
  71.     register char *s;
  72.     register int i;
  73.  
  74.     if (str->str_rare)
  75.     return stab_val(stab);
  76.  
  77.     switch (*stab->str_magic->str_ptr) {
  78.     case '\004':        /* ^D */
  79. #ifdef DEBUGGING
  80.     str_numset(stab_val(stab),(double)(debug & 32767));
  81. #endif
  82.     break;
  83.     case '\006':        /* ^F */
  84.     str_numset(stab_val(stab),(double)maxsysfd);
  85.     break;
  86.     case '\t':            /* ^I */
  87.     if (inplace)
  88.         str_set(stab_val(stab), inplace);
  89.     else
  90.         str_sset(stab_val(stab),&str_undef);
  91.     break;
  92.     case '\020':        /* ^P */
  93.     str_numset(stab_val(stab),(double)perldb);
  94.     break;
  95.     case '\024':        /* ^T */
  96.     str_numset(stab_val(stab),(double)basetime);
  97.     break;
  98.     case '\027':        /* ^W */
  99.     str_numset(stab_val(stab),(double)dowarn);
  100.     break;
  101.     case '1': case '2': case '3': case '4':
  102.     case '5': case '6': case '7': case '8': case '9': case '&':
  103.     if (curspat) {
  104.         paren = atoi(stab_ename(stab));
  105.       getparen:
  106.         if (curspat->spat_regexp &&
  107.           paren <= curspat->spat_regexp->nparens &&
  108.           (s = curspat->spat_regexp->startp[paren]) ) {
  109.         i = curspat->spat_regexp->endp[paren] - s;
  110.         if (i >= 0)
  111.             str_nset(stab_val(stab),s,i);
  112.         else
  113.             str_sset(stab_val(stab),&str_undef);
  114.         }
  115.         else
  116.         str_sset(stab_val(stab),&str_undef);
  117.     }
  118.     break;
  119.     case '+':
  120.     if (curspat) {
  121.         paren = curspat->spat_regexp->lastparen;
  122.         goto getparen;
  123.     }
  124.     break;
  125.     case '`':
  126.     if (curspat) {
  127.         if (curspat->spat_regexp &&
  128.           (s = curspat->spat_regexp->subbeg) ) {
  129.         i = curspat->spat_regexp->startp[0] - s;
  130.         if (i >= 0)
  131.             str_nset(stab_val(stab),s,i);
  132.         else
  133.             str_nset(stab_val(stab),"",0);
  134.         }
  135.         else
  136.         str_nset(stab_val(stab),"",0);
  137.     }
  138.     break;
  139.     case '\'':
  140.     if (curspat) {
  141.         if (curspat->spat_regexp &&
  142.           (s = curspat->spat_regexp->endp[0]) ) {
  143.         str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
  144.         }
  145.         else
  146.         str_nset(stab_val(stab),"",0);
  147.     }
  148.     break;
  149.     case '.':
  150. #ifndef lint
  151.     if (last_in_stab && stab_io(last_in_stab)) {
  152.         str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
  153.     }
  154. #endif
  155.     break;
  156.     case '?':
  157.     str_numset(stab_val(stab),(double)statusvalue);
  158.     break;
  159.     case '^':
  160.     s = stab_io(curoutstab)->top_name;
  161.     if (s)
  162.         str_set(stab_val(stab),s);
  163.     else {
  164.         str_set(stab_val(stab),stab_ename(curoutstab));
  165.         str_cat(stab_val(stab),"_TOP");
  166.     }
  167.     break;
  168.     case '~':
  169.     s = stab_io(curoutstab)->fmt_name;
  170.     if (!s)
  171.         s = stab_ename(curoutstab);
  172.     str_set(stab_val(stab),s);
  173.     break;
  174. #ifndef lint
  175.     case '=':
  176.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
  177.     break;
  178.     case '-':
  179.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
  180.     break;
  181.     case '%':
  182.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
  183.     break;
  184. #endif
  185.     case ':':
  186.     break;
  187.     case '/':
  188.     break;
  189.     case '[':
  190.     str_numset(stab_val(stab),(double)arybase);
  191.     break;
  192.     case '|':
  193.     if (!stab_io(curoutstab))
  194.         stab_io(curoutstab) = stio_new();
  195.     str_numset(stab_val(stab),
  196.        (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
  197.     break;
  198.     case ',':
  199.     str_nset(stab_val(stab),ofs,ofslen);
  200.     break;
  201.     case '\\':
  202.     str_nset(stab_val(stab),ors,orslen);
  203.     break;
  204.     case '#':
  205.     str_set(stab_val(stab),ofmt);
  206.     break;
  207.     case '!':
  208.     str_numset(stab_val(stab), (double)errno);
  209.     str_set(stab_val(stab), errno ? strerror(errno) : "");
  210.     stab_val(stab)->str_nok = 1;    /* what a wonderful hack! */
  211.     break;
  212.     case '<':
  213.     str_numset(stab_val(stab),(double)uid);
  214.     break;
  215.     case '>':
  216.     str_numset(stab_val(stab),(double)euid);
  217.     break;
  218.     case '(':
  219.     s = buf;
  220.     (void)sprintf(s,"%d",(int)gid);
  221.     goto add_groups;
  222.     case ')':
  223.     s = buf;
  224.     (void)sprintf(s,"%d",(int)egid);
  225.       add_groups:
  226.     while (*s) s++;
  227. #ifdef HAS_GETGROUPS
  228. #ifndef NGROUPS
  229. #define NGROUPS 32
  230. #endif
  231.     {
  232.         GROUPSTYPE gary[NGROUPS];
  233.  
  234.         i = getgroups(NGROUPS,gary);
  235.         while (--i >= 0) {
  236.         (void)sprintf(s," %ld", (long)gary[i]);
  237.         while (*s) s++;
  238.         }
  239.     }
  240. #endif
  241.     str_set(stab_val(stab),buf);
  242.     break;
  243.     case '*':
  244.     break;
  245.     case '0':
  246.     break;
  247.     default:
  248.     {
  249.         struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
  250.  
  251.         if (uf && uf->uf_val)
  252.         (*uf->uf_val)(uf->uf_index, stab_val(stab));
  253.     }
  254.     break;
  255.     }
  256.     return stab_val(stab);
  257. }
  258.  
  259. STRLEN
  260. stab_len(str)
  261. STR *str;
  262. {
  263.     STAB *stab = str->str_u.str_stab;
  264.     int paren;
  265.     int i;
  266.     char *s;
  267.  
  268.     if (str->str_rare)
  269.     return str_len(stab_val(stab));
  270.  
  271.     switch (*stab->str_magic->str_ptr) {
  272.     case '1': case '2': case '3': case '4':
  273.     case '5': case '6': case '7': case '8': case '9': case '&':
  274.     if (curspat) {
  275.         paren = atoi(stab_ename(stab));
  276.       getparen:
  277.         if (curspat->spat_regexp &&
  278.           paren <= curspat->spat_regexp->nparens &&
  279.           (s = curspat->spat_regexp->startp[paren]) ) {
  280.         i = curspat->spat_regexp->endp[paren] - s;
  281.         if (i >= 0)
  282.             return i;
  283.         else
  284.             return 0;
  285.         }
  286.         else
  287.         return 0;
  288.     }
  289.     break;
  290.     case '+':
  291.     if (curspat) {
  292.         paren = curspat->spat_regexp->lastparen;
  293.         goto getparen;
  294.     }
  295.     break;
  296.     case '`':
  297.     if (curspat) {
  298.         if (curspat->spat_regexp &&
  299.           (s = curspat->spat_regexp->subbeg) ) {
  300.         i = curspat->spat_regexp->startp[0] - s;
  301.         if (i >= 0)
  302.             return i;
  303.         else
  304.             return 0;
  305.         }
  306.         else
  307.         return 0;
  308.     }
  309.     break;
  310.     case '\'':
  311.     if (curspat) {
  312.         if (curspat->spat_regexp &&
  313.           (s = curspat->spat_regexp->endp[0]) ) {
  314.         return (STRLEN) (curspat->spat_regexp->subend - s);
  315.         }
  316.         else
  317.         return 0;
  318.     }
  319.     break;
  320.     case ',':
  321.     return (STRLEN)ofslen;
  322.     case '\\':
  323.     return (STRLEN)orslen;
  324.     }
  325.     return str_len(stab_str(str));
  326. }
  327.  
  328. void
  329. stabset(mstr,str)
  330. register STR *mstr;
  331. STR *str;
  332. {
  333.     STAB *stab;
  334.     register char *s;
  335.     int i;
  336.  
  337.     switch (mstr->str_rare) {
  338.     case 'E':
  339.     my_setenv(mstr->str_ptr,str_get(str));
  340.                 /* And you'll never guess what the dog had */
  341.                 /*   in its mouth... */
  342. #ifdef TAINT
  343.     if (strEQ(mstr->str_ptr,"PATH")) {
  344.         char *strend = str->str_ptr + str->str_cur;
  345.  
  346.         s = str->str_ptr;
  347.         while (s < strend) {
  348.         s = cpytill(tokenbuf,s,strend,':',&i);
  349.         s++;
  350.         if (*tokenbuf != '/'
  351.           || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  352.             str->str_tainted = 2;
  353.         }
  354.     }
  355. #endif
  356.     break;
  357.     case 'S':
  358.     s = str_get(str);
  359.     i = whichsig(mstr->str_ptr);    /* ...no, a brick */
  360.     if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM")))
  361.         warn("No such signal: SIG%s", mstr->str_ptr);
  362.     if (strEQ(s,"IGNORE"))
  363. #ifndef lint
  364.         (void)signal(i,SIG_IGN);
  365. #else
  366.         ;
  367. #endif
  368.     else if (strEQ(s,"DEFAULT") || !*s)
  369.         (void)signal(i,SIG_DFL);
  370.     else {
  371.         (void)signal(i,sighandler);
  372.         if (!index(s,'\'')) {
  373.         sprintf(tokenbuf, "main'%s",s);
  374.         str_set(str,tokenbuf);
  375.         }
  376.     }
  377.     break;
  378. #ifdef SOME_DBM
  379.     case 'D':
  380.     stab = mstr->str_u.str_stab;
  381.     hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
  382.     break;
  383. #endif
  384.     case 'L':
  385.     {
  386.         CMD *cmd;
  387.  
  388.         stab = mstr->str_u.str_stab;
  389.         i = str_true(str);
  390.         str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
  391.         if (str->str_magic && (cmd = str->str_magic->str_u.str_cmd)) {
  392.         cmd->c_flags &= ~CF_OPTIMIZE;
  393.         cmd->c_flags |= i? CFT_D1 : CFT_D0;
  394.         }
  395.         else
  396.         warn("Can't break at that line\n");
  397.     }
  398.     break;
  399.     case '#':
  400.     stab = mstr->str_u.str_stab;
  401.     afill(stab_array(stab), (int)str_gnum(str) - arybase);
  402.     break;
  403.     case 'X':    /* merely a copy of a * string */
  404.     break;
  405.     case '*':
  406.     s = str->str_pok ? str_get(str) : "";
  407.     if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
  408.         stab = mstr->str_u.str_stab;
  409.         if (!*s) {
  410.         STBP *stbp;
  411.  
  412.         /*SUPPRESS 701*/
  413.         (void)savenostab(stab);    /* schedule a free of this stab */
  414.         if (stab->str_len)
  415.             Safefree(stab->str_ptr);
  416.         Newz(601,stbp, 1, STBP);
  417.         stab->str_ptr = stbp;
  418.         stab->str_len = stab->str_cur = sizeof(STBP);
  419.         stab->str_pok = 1;
  420.         strcpy(stab_magic(stab),"StB");
  421.         stab_val(stab) = Str_new(70,0);
  422.         stab_line(stab) = curcmd->c_line;
  423.         stab_estab(stab) = stab;
  424.         }
  425.         else {
  426.         stab = stabent(s,TRUE);
  427.         if (!stab_xarray(stab))
  428.             aadd(stab);
  429.         if (!stab_xhash(stab))
  430.             hadd(stab);
  431.         if (!stab_io(stab))
  432.             stab_io(stab) = stio_new();
  433.         }
  434.         str_sset(str, (STR*) stab);
  435.     }
  436.     break;
  437.     case 's': {
  438.         struct lstring *lstr = (struct lstring*)str;
  439.         char *tmps;
  440.  
  441.         mstr->str_rare = 0;
  442.         str->str_magic = Nullstr;
  443.         tmps = str_get(str);
  444.         str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
  445.           tmps,str->str_cur);
  446.     }
  447.     break;
  448.  
  449.     case 'v':
  450.     do_vecset(mstr,str);
  451.     break;
  452.  
  453.     case 0:
  454.     /*SUPPRESS 560*/
  455.     if (!(stab = mstr->str_u.str_stab))
  456.         break;
  457.     switch (*stab->str_magic->str_ptr) {
  458.     case '\004':    /* ^D */
  459. #ifdef DEBUGGING
  460.         debug = (int)(str_gnum(str)) | 32768;
  461.         if (debug & 1024)
  462.         dump_all();
  463. #endif
  464.         break;
  465.     case '\006':    /* ^F */
  466.         maxsysfd = (int)str_gnum(str);
  467.         break;
  468.     case '\t':    /* ^I */
  469.         if (inplace)
  470.         Safefree(inplace);
  471.         if (str->str_pok || str->str_nok)
  472.         inplace = savestr(str_get(str));
  473.         else
  474.         inplace = Nullch;
  475.         break;
  476.     case '\020':    /* ^P */
  477.         i = (int)str_gnum(str);
  478.         if (i != perldb) {
  479.         static SPAT * oldlastspat;
  480.  
  481.         if (perldb)
  482.             oldlastspat = lastspat;
  483.         else
  484.             lastspat = oldlastspat;
  485.         }
  486.         perldb = i;
  487.         break;
  488.     case '\024':    /* ^T */
  489.         basetime = (time_t)str_gnum(str);
  490.         break;
  491.     case '\027':    /* ^W */
  492.         dowarn = (bool)str_gnum(str);
  493.         break;
  494.     case '.':
  495.         if (localizing)
  496.         savesptr((STR**)&last_in_stab);
  497.         break;
  498.     case '^':
  499.         Safefree(stab_io(curoutstab)->top_name);
  500.         stab_io(curoutstab)->top_name = s = savestr(str_get(str));
  501.         stab_io(curoutstab)->top_stab = stabent(s,TRUE);
  502.         break;
  503.     case '~':
  504.         Safefree(stab_io(curoutstab)->fmt_name);
  505.         stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
  506.         stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
  507.         break;
  508.     case '=':
  509.         stab_io(curoutstab)->page_len = (long)str_gnum(str);
  510.         break;
  511.     case '-':
  512.         stab_io(curoutstab)->lines_left = (long)str_gnum(str);
  513.         if (stab_io(curoutstab)->lines_left < 0L)
  514.         stab_io(curoutstab)->lines_left = 0L;
  515.         break;
  516.     case '%':
  517.         stab_io(curoutstab)->page = (long)str_gnum(str);
  518.         break;
  519.     case '|':
  520.         if (!stab_io(curoutstab))
  521.         stab_io(curoutstab) = stio_new();
  522.         stab_io(curoutstab)->flags &= ~IOF_FLUSH;
  523.         if (str_gnum(str) != 0.0) {
  524.         stab_io(curoutstab)->flags |= IOF_FLUSH;
  525.         }
  526.         break;
  527.     case '*':
  528.         i = (int)str_gnum(str);
  529.         multiline = (i != 0);
  530.         break;
  531.     case '/':
  532.         if (str->str_pok) {
  533.         rs = str_get(str);
  534.         rslen = str->str_cur;
  535.         if (rspara = !rslen) {
  536.             rs = "\n\n";
  537.             rslen = 2;
  538.         }
  539.         rschar = rs[rslen - 1];
  540.         }
  541.         else {
  542.         rschar = 0777;    /* fake a non-existent char */
  543.         rslen = 1;
  544.         }
  545.         break;
  546.     case '\\':
  547.         if (ors)
  548.         Safefree(ors);
  549.         ors = savestr(str_get(str));
  550.         orslen = str->str_cur;
  551.         break;
  552.     case ',':
  553.         if (ofs)
  554.         Safefree(ofs);
  555.         ofs = savestr(str_get(str));
  556.         ofslen = str->str_cur;
  557.         break;
  558.     case '#':
  559.         if (ofmt)
  560.         Safefree(ofmt);
  561.         ofmt = savestr(str_get(str));
  562.         break;
  563.     case '[':
  564.         arybase = (int)str_gnum(str);
  565.         break;
  566.     case '?':
  567.         statusvalue = U_S(str_gnum(str));
  568.         break;
  569.     case '!':
  570.         errno = (int)str_gnum(str);        /* will anyone ever use this? */
  571.         break;
  572.     case '<':
  573.         uid = (int)str_gnum(str);
  574.         if (delaymagic) {
  575.         delaymagic |= DM_RUID;
  576.         break;                /* don't do magic till later */
  577.         }
  578. #ifdef HAS_SETRUID
  579.         (void)setruid((UIDTYPE)uid);
  580. #else
  581. #ifdef HAS_SETREUID
  582.         (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
  583. #else
  584.         if (uid == euid)        /* special case $< = $> */
  585.         (void)setuid(uid);
  586.         else
  587.         fatal("setruid() not implemented");
  588. #endif
  589. #endif
  590.         uid = (int)getuid();
  591.         break;
  592.     case '>':
  593.         euid = (int)str_gnum(str);
  594.         if (delaymagic) {
  595.         delaymagic |= DM_EUID;
  596.         break;                /* don't do magic till later */
  597.         }
  598. #ifdef HAS_SETEUID
  599.         (void)seteuid((UIDTYPE)euid);
  600. #else
  601. #ifdef HAS_SETREUID
  602.         (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
  603. #else
  604.         if (euid == uid)        /* special case $> = $< */
  605.         setuid(euid);
  606.         else
  607.         fatal("seteuid() not implemented");
  608. #endif
  609. #endif
  610.         euid = (int)geteuid();
  611.         break;
  612.     case '(':
  613.         gid = (int)str_gnum(str);
  614.         if (delaymagic) {
  615.         delaymagic |= DM_RGID;
  616.         break;                /* don't do magic till later */
  617.         }
  618. #ifdef HAS_SETRGID
  619.         (void)setrgid((GIDTYPE)gid);
  620. #else
  621. #ifdef HAS_SETREGID
  622.         (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
  623. #else
  624.         if (gid == egid)            /* special case $( = $) */
  625.         (void)setgid(gid);
  626.         else
  627.         fatal("setrgid() not implemented");
  628. #endif
  629. #endif
  630.         gid = (int)getgid();
  631.         break;
  632.     case ')':
  633.         egid = (int)str_gnum(str);
  634.         if (delaymagic) {
  635.         delaymagic |= DM_EGID;
  636.         break;                /* don't do magic till later */
  637.         }
  638. #ifdef HAS_SETEGID
  639.         (void)setegid((GIDTYPE)egid);
  640. #else
  641. #ifdef HAS_SETREGID
  642.         (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
  643. #else
  644.         if (egid == gid)            /* special case $) = $( */
  645.         (void)setgid(egid);
  646.         else
  647.         fatal("setegid() not implemented");
  648. #endif
  649. #endif
  650.         egid = (int)getegid();
  651.         break;
  652.     case ':':
  653.         chopset = str_get(str);
  654.         break;
  655.     case '0':
  656.         if (!origalen) {
  657.         s = origargv[0];
  658.         s += strlen(s);
  659.         /* See if all the arguments are contiguous in memory */
  660.         for (i = 1; i < origargc; i++) {
  661.             if (origargv[i] == s + 1)
  662.             s += strlen(++s);    /* this one is ok too */
  663.         }
  664.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  665.             my_setenv("NoNeSuCh", Nullch);
  666.                         /* force copy of environment */
  667.             for (i = 0; origenviron[i]; i++)
  668.             if (origenviron[i] == s + 1)
  669.                 s += strlen(++s);
  670.         }
  671.         origalen = s - origargv[0];
  672.         }
  673.         s = str_get(str);
  674.         i = str->str_cur;
  675.         if (i >= origalen) {
  676.         i = origalen;
  677.         str->str_cur = i;
  678.         str->str_ptr[i] = '\0';
  679.         Copy(s, origargv[0], i, char);
  680.         }
  681.         else {
  682.         Copy(s, origargv[0], i, char);
  683.         s = origargv[0]+i;
  684.         *s++ = '\0';
  685.         while (++i < origalen)
  686.             *s++ = ' ';
  687.         }
  688.         break;
  689.     default:
  690.         {
  691.         struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
  692.  
  693.         if (uf && uf->uf_set)
  694.             (*uf->uf_set)(uf->uf_index, str);
  695.         }
  696.         break;
  697.     }
  698.     break;
  699.     }
  700. }
  701.  
  702. int
  703. whichsig(sig)
  704. char *sig;
  705. {
  706.     register char **sigv;
  707.  
  708.     for (sigv = sig_name+1; *sigv; sigv++)
  709.     if (strEQ(sig,*sigv))
  710.         return sigv - sig_name;
  711. #ifdef SIGCLD
  712.     if (strEQ(sig,"CHLD"))
  713.     return SIGCLD;
  714. #endif
  715. #ifdef SIGCHLD
  716.     if (strEQ(sig,"CLD"))
  717.     return SIGCHLD;
  718. #endif
  719.     return 0;
  720. }
  721.  
  722. static handlertype
  723. sighandler(sig)
  724. int sig;
  725. {
  726.     STAB *stab;
  727.     STR *str;
  728.     int oldsave = savestack->ary_fill;
  729.     int oldtmps_base = tmps_base;
  730.     register CSV *csv;
  731.     SUBR *sub;
  732.  
  733. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  734.     signal(sig, SIG_ACK);
  735. #endif
  736.     stab = stabent(
  737.     str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
  738.       TRUE)), TRUE);
  739.     sub = stab_sub(stab);
  740.     if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  741.     if (sig_name[sig][1] == 'H')
  742.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
  743.           TRUE);
  744.     else
  745.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
  746.           TRUE);
  747.     sub = stab_sub(stab);    /* gag */
  748.     }
  749.     if (!sub) {
  750.     if (dowarn)
  751.         warn("SIG%s handler \"%s\" not defined.\n",
  752.         sig_name[sig], stab_ename(stab) );
  753.     return;
  754.     }
  755.     /*SUPPRESS 701*/
  756.     saveaptr(&stack);
  757.     str = Str_new(15, sizeof(CSV));
  758.     str->str_state = SS_SCSV;
  759.     (void)apush(savestack,str);
  760.     csv = (CSV*)str->str_ptr;
  761.     csv->sub = sub;
  762.     csv->stab = stab;
  763.     csv->curcsv = curcsv;
  764.     csv->curcmd = curcmd;
  765.     csv->depth = sub->depth;
  766.     csv->wantarray = G_SCALAR;
  767.     csv->hasargs = TRUE;
  768.     csv->savearray = stab_xarray(defstab);
  769.     csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
  770.     stack->ary_flags = 0;
  771.     curcsv = csv;
  772.     str = str_mortal(&str_undef);
  773.     str_set(str,sig_name[sig]);
  774.     (void)apush(stab_xarray(defstab),str);
  775.     sub->depth++;
  776.     if (sub->depth >= 2) {    /* save temporaries on recursion? */
  777.     if (sub->depth == 100 && dowarn)
  778.         warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
  779.     savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  780.     }
  781.  
  782.     tmps_base = tmps_max;        /* protect our mortal string */
  783.     (void)cmd_exec(sub->cmd,G_SCALAR,0);        /* so do it already */
  784.     tmps_base = oldtmps_base;
  785.  
  786.     restorelist(oldsave);        /* put everything back */
  787. }
  788.  
  789. STAB *
  790. aadd(stab)
  791. register STAB *stab;
  792. {
  793.     if (!stab_xarray(stab))
  794.     stab_xarray(stab) = anew(stab);
  795.     return stab;
  796. }
  797.  
  798. STAB *
  799. hadd(stab)
  800. register STAB *stab;
  801. {
  802.     if (!stab_xhash(stab))
  803.     stab_xhash(stab) = hnew(COEFFSIZE);
  804.     return stab;
  805. }
  806.  
  807. STAB *
  808. fstab(name)
  809. char *name;
  810. {
  811.     char tmpbuf[1200];
  812.     STAB *stab;
  813.  
  814.     sprintf(tmpbuf,"'_<%s", name);
  815.     stab = stabent(tmpbuf, TRUE);
  816.     str_set(stab_val(stab), name);
  817.     if (perldb)
  818.     (void)hadd(aadd(stab));
  819.     return stab;
  820. }
  821.  
  822. STAB *
  823. stabent(name,add)
  824. register char *name;
  825. int add;
  826. {
  827.     register STAB *stab;
  828.     register STBP *stbp;
  829.     int len;
  830.     register char *namend;
  831.     HASH *stash;
  832.     char *sawquote = Nullch;
  833.     char *prevquote = Nullch;
  834.     bool global = FALSE;
  835.  
  836.     if (isUPPER(*name)) {
  837.     if (*name > 'I') {
  838.         if (*name == 'S' && (
  839.           strEQ(name, "SIG") ||
  840.           strEQ(name, "STDIN") ||
  841.           strEQ(name, "STDOUT") ||
  842.           strEQ(name, "STDERR") ))
  843.         global = TRUE;
  844.     }
  845.     else if (*name > 'E') {
  846.         if (*name == 'I' && strEQ(name, "INC"))
  847.         global = TRUE;
  848.     }
  849.     else if (*name > 'A') {
  850.         if (*name == 'E' && strEQ(name, "ENV"))
  851.         global = TRUE;
  852.     }
  853.     else if (*name == 'A' && (
  854.       strEQ(name, "ARGV") ||
  855.       strEQ(name, "ARGVOUT") ))
  856.         global = TRUE;
  857.     }
  858.     for (namend = name; *namend; namend++) {
  859.     if (*namend == '\'' && namend[1])
  860.         prevquote = sawquote, sawquote = namend;
  861.     }
  862.     if (sawquote == name && name[1]) {
  863.     stash = defstash;
  864.     sawquote = Nullch;
  865.     name++;
  866.     }
  867.     else if (!isALPHA(*name) || global)
  868.     stash = defstash;
  869.     else if ((CMD*)curcmd == &compiling)
  870.     stash = curstash;
  871.     else
  872.     stash = curcmd->c_stash;
  873.     if (sawquote) {
  874.     char tmpbuf[256];
  875.     char *s, *d;
  876.  
  877.     *sawquote = '\0';
  878.     /*SUPPRESS 560*/
  879.     if (s = prevquote) {
  880.         strncpy(tmpbuf,name,s-name+1);
  881.         d = tmpbuf+(s-name+1);
  882.         *d++ = '_';
  883.         strcpy(d,s+1);
  884.     }
  885.     else {
  886.         *tmpbuf = '_';
  887.         strcpy(tmpbuf+1,name);
  888.     }
  889.     stab = stabent(tmpbuf,TRUE);
  890.     if (!(stash = stab_xhash(stab)))
  891.         stash = stab_xhash(stab) = hnew(0);
  892.     if (!stash->tbl_name)
  893.         stash->tbl_name = savestr(name);
  894.     name = sawquote+1;
  895.     *sawquote = '\'';
  896.     }
  897.     len = namend - name;
  898.     stab = (STAB*)hfetch(stash,name,len,add);
  899.     if (stab == (STAB*)&str_undef)
  900.     return Nullstab;
  901.     if (stab->str_pok) {
  902.     stab->str_pok |= SP_MULTI;
  903.     return stab;
  904.     }
  905.     else {
  906.     if (stab->str_len)
  907.         Safefree(stab->str_ptr);
  908.     Newz(602,stbp, 1, STBP);
  909.     stab->str_ptr = stbp;
  910.     stab->str_len = stab->str_cur = sizeof(STBP);
  911.     stab->str_pok = 1;
  912.     strcpy(stab_magic(stab),"StB");
  913.     stab_val(stab) = Str_new(72,0);
  914.     stab_line(stab) = curcmd->c_line;
  915.     stab_estab(stab) = stab;
  916.     str_magic((STR*)stab, stab, '*', name, len);
  917.     stab_stash(stab) = stash;
  918.     if (isDIGIT(*name) && *name != '0') {
  919.         stab_flags(stab) = SF_VMAGIC;
  920.         str_magic(stab_val(stab), stab, 0, Nullch, 0);
  921.     }
  922.     if (add & 2)
  923.         stab->str_pok |= SP_MULTI;
  924.     return stab;
  925.     }
  926. }
  927.  
  928. void
  929. stab_fullname(str,stab)
  930. STR *str;
  931. STAB *stab;
  932. {
  933.     HASH *tb = stab_stash(stab);
  934.  
  935.     if (!tb)
  936.     return;
  937.     str_set(str,tb->tbl_name);
  938.     str_ncat(str,"'", 1);
  939.     str_scat(str,stab->str_magic);
  940. }
  941.  
  942. void
  943. stab_efullname(str,stab)
  944. STR *str;
  945. STAB *stab;
  946. {
  947.     HASH *tb = stab_estash(stab);
  948.  
  949.     if (!tb)
  950.     return;
  951.     str_set(str,tb->tbl_name);
  952.     str_ncat(str,"'", 1);
  953.     str_scat(str,stab_estab(stab)->str_magic);
  954. }
  955.  
  956. STIO *
  957. stio_new()
  958. {
  959.     STIO *stio;
  960.  
  961.     Newz(603,stio,1,STIO);
  962.     stio->page_len = 60;
  963.     return stio;
  964. }
  965.  
  966. void
  967. stab_check(min,max)
  968. int min;
  969. register int max;
  970. {
  971.     register HENT *entry;
  972.     register int i;
  973.     register STAB *stab;
  974.  
  975.     for (i = min; i <= max; i++) {
  976.     for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
  977.         stab = (STAB*)entry->hent_val;
  978.         if (stab->str_pok & SP_MULTI)
  979.         continue;
  980.         curcmd->c_line = stab_line(stab);
  981.         warn("Possible typo: \"%s\"", stab_name(stab));
  982.     }
  983.     }
  984. }
  985.  
  986. static int gensym = 0;
  987.  
  988. STAB *
  989. genstab()
  990. {
  991.     (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
  992.     return stabent(tokenbuf,TRUE);
  993. }
  994.  
  995. /* hopefully this is only called on local symbol table entries */
  996.  
  997. void
  998. stab_clear(stab)
  999. register STAB *stab;
  1000. {
  1001.     STIO *stio;
  1002.     SUBR *sub;
  1003.  
  1004.     if (!stab || !stab->str_ptr)
  1005.     return;
  1006.     afree(stab_xarray(stab));
  1007.     stab_xarray(stab) = Null(ARRAY*);
  1008. #ifndef macintosh
  1009.     (void)hfree(stab_xhash(stab), FALSE);
  1010. #else
  1011.     hfree(stab_xhash(stab), FALSE);
  1012. #endif
  1013.     stab_xhash(stab) = Null(HASH*);
  1014.     str_free(stab_val(stab));
  1015.     stab_val(stab) = Nullstr;
  1016.     /*SUPPRESS 560*/
  1017.     if (stio = stab_io(stab)) {
  1018.     do_close(stab,FALSE);
  1019.     Safefree(stio->top_name);
  1020.     Safefree(stio->fmt_name);
  1021.     Safefree(stio);
  1022.     }
  1023.     /*SUPPRESS 560*/
  1024.     if (sub = stab_sub(stab)) {
  1025.     afree(sub->tosave);
  1026.     cmd_free(sub->cmd);
  1027.     }
  1028.     Safefree(stab->str_ptr);
  1029.     stab->str_ptr = Null(STBP*);
  1030.     stab->str_len = 0;
  1031.     stab->str_cur = 0;
  1032. }
  1033.  
  1034. #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
  1035. #define MICROPORT
  1036. #endif
  1037.  
  1038. #ifdef    MICROPORT    /* Microport 2.4 hack */
  1039. ARRAY *stab_array(stab)
  1040. register STAB *stab;
  1041. {
  1042.     if (((STBP*)(stab->str_ptr))->stbp_array) 
  1043.     return ((STBP*)(stab->str_ptr))->stbp_array;
  1044.     else
  1045.     return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
  1046. }
  1047.  
  1048. HASH *stab_hash(stab)
  1049. register STAB *stab;
  1050. {
  1051.     if (((STBP*)(stab->str_ptr))->stbp_hash)
  1052.     return ((STBP*)(stab->str_ptr))->stbp_hash;
  1053.     else
  1054.     return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
  1055. }
  1056. #endif            /* Microport 2.4 hack */
  1057.  
  1058. void init_stab()
  1059. {
  1060.     origalen = 0;
  1061.     gensym = 0;
  1062. }
  1063.